{-
 This file is part of the Clafer to Alloy Translator (clafer2alloy).

 Copyright (C) 2010 Kacper Bak <http://gsd.uwaterloo.ca/kbak>

 clafer2alloy is free software: you can redistribute it and/or modify
 it under the terms of the GNU Lesser General Public License as published by
 the Free Software Foundation, either version 3 of the License, or
 (at your option) any later version.

 clafer2alloy is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU Lesser General Public License for more details.

 You should have received a copy of the GNU Lesser General Public License
 along with clafer2alloy. (See files COPYING and COPYING.LESSER.)  If not,
 see <http://www.gnu.org/licenses/>.
-}
module Common where

import Absclafer2alloy
import Data.Maybe
import Data.Tree
import List
import AlloyCode
import Data.Map (Map)
import qualified Data.Map as Map

symbolId = "id"

-- -----------------------------------------------------------------------------
-- basic functions shared by desugarer, analyzer and code generator

type Result = String


transIdent :: Ident -> Result
transIdent x = case x of
  Ident str  -> str


transName :: Name -> (Maybe Result, Result)
transName x = case x of
  Name modids id  -> (Nothing, transIdent id)


transEnumId :: EnumId -> Result
transEnumId x = case x of
  EnumIdIdent id  -> transIdent id


transModId :: ModId -> Result
transModId x = case x of
  ModIdIdent id  -> transIdent id


lookupSymName path st = snd $ fromJust $ Map.lookup path st

-- -----------------------------------------------------------------------------
-- extraction

getGCard (Clafer gcard _ _ _ _ _ _) = gcard


getClaferId (Clafer _ ident _ _ _ _ _) = ident


getSuper (Clafer _ _ sclafer _ _ _ _) = ident
  where
  (Super (Name _ ident)) = sclafer


getAttr (Clafer _ _ _ attr _ _ _) = attr


getSExpAttr (Clafer _ _ _ (AttrSExp _ sexp) _ _ _) = sexp


getCard (Clafer _ _ _ _ _ card _) = card


getElements (Clafer _ _ _ _ _ _ elements) = elements


fromElements (Elements es) = es


extractClafer x = case x of
  Subclafer clafer  -> Just clafer
  _  -> Nothing


getIdents (Decl _ _ locids _) = map (\(LocIdIdent ident) -> ident) locids

-- -----------------------------------------------------------------------------
-- processes lists with a list of functions
multiProcess = (flip (foldr ($))).(map process)


-- processes each element of the list with passing state
process f xs = unfoldr run ([], xs)
  where
  run (ps, us) = listToMaybe us >> (Just $ apply (\x -> (x : ps, tail us)) 
    (f ps us))

-- -----------------------------------------------------------------------------
-- conversions


toClafer :: Declaration -> Maybe Clafer
toClafer x = case x of
  EnumDecl ident enumids -> error "desugared"
  AbsClaferDecl gcard ident super attr elements  -> Just $
    Clafer gcard ident super attr EssentialEmpty CardEmpty elements
  ClaferDecl clafer     -> Just clafer
  ConstDecl constraint  -> Nothing


toAbsClafer :: Clafer -> Declaration
toAbsClafer x = case x of
  Clafer gcard ident super attr _ _ elements ->
    AbsClaferDecl gcard ident super attr elements


toIdents = map Ident


toAttrSuper (AttrSExp modids sexp) = AttrSuper modids sexp

-- -----------------------------------------------------------------------------
-- various predicates


isAbstract x = case x of
  AbsClaferDecl _ _ _ _ _  -> True
  _ -> False


isEqClaferId = flip $ (==).getClaferId


isReference clafer = and [ transIdent (getSuper clafer) == baseClafer
                         , getAttr clafer /= AttrEmpty
                         , [] == fromElements (getElements clafer)]


-- -----------------------------------------------------------------------------
-- sorts clafers according to their inheritance hierarchy.
-- Rather inefficient, but works...
partialSort = unfoldr


getMaxDecl :: [Declaration] -> Maybe (Declaration, [Declaration])
getMaxDecl xs = do
  x <- listToMaybe xs
  maybe (Just (x, tail xs))
        (const (getMaxDecl $ shift xs)) $
        find (flip ((==).getSuper) (getClaferId $ fromJust $ toClafer x)) $
              mapMaybe toClafer xs


-- -----------------------------------------------------------------------------
-- Finds the first element with certain property and returns
-- it. If no element is found, returns some default value.
-- Elements are sorted according to their hierarchy
findInHierarchy def pred declarations clafer =
  findInList def pred $ findHierarchy declarations clafer


findInList def pred xs = maybe def id $ find pred xs


-- finds hierarchy and transforms each element
mapHierarchy f = (map f.).findHierarchy


-- returns inheritance hierarchy of a clafer
findHierarchy :: [Clafer] -> Clafer -> [Clafer]
findHierarchy declarations clafer = clafer : unfoldr 
  (\c -> find (isEqClaferId $ getSuper c) declarations -- searches for super
     >>= Just . (apply id)) clafer


-- -----------------------------------------------------------------------------
-- various generic functions


apply f x = (x, f x)


shift (x:xs) = xs ++ [x]


-- lists all nodes of a tree (BFS). Take a function to extract subforest
bfs toNode seed = map rootLabel $ concat $ takeWhile (not.null) $
  iterate (concatMap subForest) $ unfoldForest toNode seed


pairToList = uncurry ((.return).(:))